home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / obrn-a_1.5_lib.lha / oberon-a / source2.lha / Source / ProjectOberon / Oberon.mod < prev    next >
Encoding:
Text File  |  1995-01-26  |  2.5 KB  |  108 lines
  1. (***************************************************************************
  2.  
  3.      $RCSfile: Oberon.mod $
  4.   Description: Partial port of the Project Oberon module
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.10 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 00:48:34 $
  10.  
  11.   Copyright © 1994, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15. ***************************************************************************)
  16.  
  17. <* MAIN- *> <*$ LongVars+ *>
  18.  
  19. MODULE Oberon;
  20.  
  21. IMPORT d := Dos;
  22.  
  23. (*------------------------------------*)
  24. PROCEDURE ADOS2OberonTime *
  25.   (VAR ds : d.Date; VAR time, date : LONGINT);
  26. (*
  27.   Adapted from ParseDate() in module Dates, Copyright 1987 by:
  28.     Dale W. Thompson, 14500 Dallas Pkwy. #2091, Dallas, TX 75240
  29. *)
  30.  
  31.   VAR year, month, day, hour, min, sec : LONGINT;
  32.       Days     : ARRAY 12 OF INTEGER;
  33.       LeapDays : ARRAY 12 OF INTEGER;
  34.  
  35.    PROCEDURE Leap ( year : LONGINT ) : BOOLEAN;
  36.    BEGIN
  37.       RETURN ((year-1976) MOD 4) = 0
  38.    END Leap;
  39.  
  40. BEGIN (* ADOS2OberonTime *)
  41.   hour := ds.minute DIV 60;
  42.   min := ds.minute MOD 60;
  43.   sec := ds.tick DIV d.ticksPerSecond;
  44.  
  45.   Days[0]  := 31;  LeapDays[0]  := 31;
  46.   Days[1]  := 28;  LeapDays[1]  := 29;
  47.   Days[2]  := 31;  LeapDays[2]  := 31;
  48.   Days[3]  := 30;  LeapDays[3]  := 30;
  49.   Days[4]  := 31;  LeapDays[4]  := 31;
  50.   Days[5]  := 30;  LeapDays[5]  := 30;
  51.   Days[6]  := 31;  LeapDays[6]  := 31;
  52.   Days[7]  := 31;  LeapDays[7]  := 31;
  53.   Days[8]  := 30;  LeapDays[8]  := 30;
  54.   Days[9]  := 31;  LeapDays[9]  := 31;
  55.   Days[10] := 30;  LeapDays[10] := 30;
  56.   Days[11] := 31;  LeapDays[11] := 31;
  57.  
  58.   day := ds.days;
  59.   year := 1978;
  60.   LOOP
  61.     IF Leap (year) THEN
  62.       IF day < 366 THEN
  63.          EXIT;
  64.       ELSE
  65.          DEC( day,366 );
  66.       END;
  67.     ELSE
  68.       IF day < 365 THEN
  69.          EXIT;
  70.       ELSE
  71.          DEC( day,365 );
  72.       END;
  73.     END;
  74.     INC (year);
  75.   END; (* LOOP *)
  76.   INC (day);
  77.  
  78.   month := 0;
  79.   IF Leap (year) THEN
  80.     WHILE day > LeapDays [month] DO
  81.       DEC (day, LeapDays [month]);
  82.       INC (month);
  83.     END;
  84.   ELSE
  85.     WHILE day > Days [month] DO
  86.       DEC (day, Days [month]);
  87.       INC (month);
  88.     END;
  89.   END;
  90.   INC (month);
  91.  
  92.   time := (hour * 64 + min) * 64 + sec;
  93.   date := (year * 16 + month) * 32 + day;
  94. END ADOS2OberonTime;
  95.  
  96. (*------------------------------------*)
  97. PROCEDURE GetClock * (VAR time, date : LONGINT);
  98.  
  99.   VAR ds : d.Date;
  100.  
  101. BEGIN (* GetClock *)
  102.   d.DateStamp (ds);
  103.   ADOS2OberonTime (ds, time, date);
  104. END GetClock;
  105.  
  106.  
  107. END Oberon.
  108.